|
Hallo Mirko,
freut mich, dass es dir geholfen hat. Woran lag es denn, dass der Code bei dir nicht "wie gewünscht funktionierte"? Welche Information hat dir geholfen und welche weniger?
"Ist es auch möglich, dass alle Werte der Quell-Datei untereinander in der Ziel-Datei stehen?"
Ja.
"Momentan werden sie ja separat in einen neuen Reiter geschrieben. (Ich denke, man benötigt eine Arte Counter, der die Anzahl an Dateien in dem Ordner zählt und dann eine Schleife. Wie zählt man denn die Dateien in einem Ordner und kommt die Schleife in den Do-While-Loop?"
Ich habe deinen ersten Post so verstanden, dass sie immer in ein neues Tabellenblatt geschrieben werden sollen. Es gibt verschiedene Möglichkeiten, die Anzahl der Dateien in einem Ordner festzustellen (man kann z.B. eine Schleife über alle Dateien eines Verzeichnisses durchlaufen und dabei zählen, oder man kann ein Verzeichnis als "Objekt einlesen" - das Objekt hat dann schon die Anzahl der Dateien als Eigenschaft auf die man dann auch zugreifen kann).
In diesem Fall ist aber das ja nicht wirklich nötig: Wir haben ja sowieso schon eine Schleife über die *.xls*- Dateien in einem Ordner. Man kann also innerhalb dieser Schleife einfach eine Variable, die man als Zähler verwendet, immer um 1 erhöhen. Dazu benutze ich die Variable ZielZeile:
Sub zweiterVersuch()
Dim Pfad As String
Dim Fname As String
Dim wbQuelle As Workbook
Dim wsZiel As Worksheet
Dim ZielZeile As Long
Pfad = "c:\test\test\" 'abschließender Backslash!!!!!
Set wsZiel = ThisWorkbook.Worksheets.Add()
ZielZeile = 1
With wsZiel.Cells(ZielZeile, 1).Resize(1, 3)
.Value = Array("Dateiname", "Reiter1 C17", "Reiter2 F7")
.Font.Bold = True
End With
Fname = Dir(Pfad & "*.xls*")
Do While Fname <> ""
Set wbQuelle = Workbooks.Open(Pfad & Fname)
ZielZeile = ZielZeile + 1
wsZiel.Cells(ZielZeile, 1).Value = wbQuelle.Name
wsZiel.Cells(ZielZeile, 2).Value = wbQuelle.Worksheets(1).Range("C17").Value
wsZiel.Cells(ZielZeile, 3).Value = wbQuelle.Worksheets(2).Range("F7").Value
wbQuelle.Close savechanges:=False
Set wbQuelle = Nothing
Fname = Dir()
Loop
End Sub
Grüße, Ulrich
|